home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPFRX.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  16KB  |  564 lines
  1. {┌─────────────────────────────────────────────────────────────────────────┐}
  2. {│                                                                         │}
  3. {│                              T. O. P.                                   │}
  4. {│                                                                         │}
  5. {│                        (T)he  (O)ther  (P)acket                         │}
  6. {│                                                                         │}
  7. {│ T O P F R X . P A S                                                     │}
  8. {│                                                                         │}
  9. {│                                                                         │}
  10. {│ Routinen fuer die Speicherung von Savefiles                             │}
  11. {└─────────────────────────────────────────────────────────────────────────┘}
  12.  
  13.  
  14. Procedure FileRxMenu (* Kanal : Byte *);
  15. Const  ArtMax = 5;
  16. Var    i    : Byte;
  17.        KC   : Sondertaste;
  18.        VC   : Char;
  19.        Flag : Boolean;
  20.        X,Y,
  21.        Art  : Byte;
  22.  
  23. Begin
  24.   with K[Kanal]^ do
  25.   begin
  26.     Moni_Off(0);
  27.     Flag := false;
  28.     for i := 9 to 15 do G^.Fstx[i] := 2;
  29.     G^.Fstr[7] := InfoZeile(329);
  30.     G^.Fstr[9] := InfoZeile(330);
  31.     G^.Fstr[10] := InfoZeile(331);
  32.     G^.Fstr[11] := InfoZeile(332);
  33.     G^.Fstr[12] := InfoZeile(333);
  34.  
  35.     case RX_Bin of
  36.       1 : Art := 1;
  37.       2 : Art := 2;
  38.       3,
  39.       4,
  40.       5 : Art := 3;
  41.      else Art := 4;
  42.     end;
  43.  
  44.     Repeat
  45.       for i := 9 to 12 do
  46.       begin
  47.         G^.Fstr[i][vM+1] := B1;
  48.         G^.Fstr[i][hM+1] := B1;
  49.         G^.Fstr[i][vM] := B1;
  50.         G^.Fstr[i][hM] := B1;
  51.       end;
  52.  
  53.       if Art in [1..4] then
  54.       begin
  55.         X := vM;
  56.         Y := Art + 8;
  57.       end else
  58.       begin
  59.         X := hM;
  60.         Y := Art + 4;
  61.       end;
  62.       G^.Fstr[Y][X] := A_ch;
  63.  
  64.       if HardCur then SetzeCursor(X+1,Y);
  65.  
  66.       case RX_Bin of
  67.         1 : G^.Fstr[9][vM+1] := X_ch;
  68.         2 : G^.Fstr[10][vM+1] := X_ch;
  69.         3,
  70.         4 : G^.Fstr[11][vM+1] := 'x';
  71.         5 : G^.Fstr[11][vM+1] := X_ch;
  72.       end;
  73.  
  74.       if Save then G^.Fstr[12][vM+1] := X_ch;
  75.  
  76.       G^.Fstr[13] := '';
  77.       G^.Fstr[14] := '';
  78.       G^.Fstr[15] := '';
  79.       Fenster;
  80.  
  81.       _ReadKey(KC,VC);
  82.       Case KC of
  83.         _Esc : Flag := true;
  84.  
  85.         _Ret : ;
  86.  
  87.          _F1 : Art := 1;
  88.          _F2 : Art := 2;
  89.          _F3 : Art := 3;
  90.          _F4 : Art := 4;
  91.          _F5 : Art := 5;
  92.          _F6,
  93.          _F7,
  94.          _F8,
  95.          _F9,
  96.         _F10 : Alarm;
  97.  
  98.          _Up : if Art > 1  then dec(Art)
  99.                            else Alarm;
  100.  
  101.          _Dn : if Art < ArtMax then inc(Art)
  102.                                else Alarm;
  103.  
  104.       _Right : if Art < ArtMax  then
  105.                begin
  106.                  Art := Art + 4;
  107.                  if Art > ArtMax then Art := ArtMax;
  108.                end else Alarm;
  109.  
  110.        _Left : if Art > 1 then
  111.                begin
  112.                  if Art <= 4 then Art := 1
  113.                              else Art := Art - 4;
  114.                end else Alarm;
  115.  
  116.        _AltH : TOP_Help(G^.OHelp[21]);
  117.  
  118.          else Alarm;
  119.       End;
  120.  
  121.       if KC in [_F1.._F5,_Ret] then
  122.       case Art of
  123.         1,
  124.         2,
  125.         3 : begin
  126.               case Art of
  127.                 1 : G^.Fstr[9][vM] := S_ch;
  128.                 2 : G^.Fstr[10][vM] := S_ch;
  129.                 3 : G^.Fstr[11][vM] := S_ch;
  130.               end;
  131.               Fenster;
  132.               Datei_Empfangen(Kanal,Art);
  133.               if RX_Bin > 0 then Flag := true;
  134.             end;
  135.  
  136.         4 : begin
  137.               G^.Fstr[12][vM] := S_ch;
  138.               SaveFile(Kanal);
  139.               if Save then Flag := true;
  140.             end;
  141.  
  142.         5 : Kill_Save_File(Kanal);
  143.       end;
  144.  
  145.       SetzeFlags(Kanal);
  146.     Until Flag;
  147.     ClrFenster;
  148.     Neu_Bild;
  149.     Moni_On;
  150.   end;
  151. End;
  152.  
  153.  
  154. Procedure Datei_Empfangen (* Kanal : Byte; Art : Byte *);
  155. Var       Flag,
  156.           Fehler  : Boolean;
  157.           l,
  158.           Size    : LongInt;
  159.           KC      : Sondertaste;
  160.           SizeStr : String[10];
  161.           Hstr    : String[60];
  162.           i       : Byte;
  163. Begin
  164.   if Kanal > 0 then with K[Kanal]^ do
  165.   begin
  166.     if RX_Save then
  167.     begin
  168.       Size := FilePos(RXFile);
  169.       CloseRxFile(Kanal,1);
  170.       if Size < 1 then FiResult := EraseBin(RXFile);
  171.       RemoteSave := false;
  172.       Ignore := false;
  173.       RX_Save := false;
  174.       RX_Bin := 0;
  175.       AutoBinOn := AutoBin;
  176.     end else
  177.     begin
  178.       if RX_Bin = 0 then
  179.       begin
  180.         Fehler := false;
  181.         Flag := false;
  182.         Remotesave := false;
  183.         RX_Bin := Art;
  184.  
  185.         GetString(FRxName,Attrib[3],60,2,15,KC,1,Ins);
  186.         if KC <> _Esc then
  187.         begin
  188.           FRxName := SvFRxCheck(Kanal,FRxName,TxtName);
  189.  
  190.           if not PfadOk(1,FRxName) then
  191.           begin
  192.             Hstr := FRxName;
  193.             While Hstr[length(Hstr)] <> BS do delete(Hstr,length(Hstr),1);
  194.             Flag := MkSub(Hstr) and PfadOk(1,FRxName);
  195.           end else Flag := true;
  196.  
  197.           if Flag then
  198.           begin
  199.             if RX_Bin = 1 then         (* Textfile *)
  200.             begin
  201.               if OpenTextFile(Kanal) then
  202.               begin
  203.                 RX_Count := 0;
  204.                 RX_Laenge := 0;
  205.                 RX_TextZn := 0;
  206.                 RX_Time := Uhrzeit;
  207.                 RX_Save := true;
  208.               end else Fehler := true;
  209.             end else
  210.  
  211.             if RX_Bin = 2 then   (* Binär *)
  212.             begin
  213.               Assign(RXFile,FRxName);
  214.               if ResetBin(RxFile,T) = 0 then
  215.               begin    (* File vorhanden !!! *)
  216.                 SizeStr := int_str(FileSize(RXFile));
  217.                 G^.Fstr[14] := FRxName + B1 + InfoZeile(156);
  218.                 G^.Fstr[15] := InfoZeile(286) + B1+ FormByte(SizeStr) + B3 + InfoZeile(287);
  219.                 Size := FileSize(RXFile);
  220.                 if Size mod 1000 < 300 then Size := Size - 1000;
  221.                 if Size < 0 then Size := 0;
  222.                 SizeStr := int_str((Size div 1000) * 1000);
  223.                 Fenster;
  224.                 Alarm;
  225.                 GetString(SizeStr,Attrib[3],10,length(G^.Fstr[15])+3,15,KC,3,Ins);
  226.                 if KC <> _Esc then
  227.                 begin
  228.                   Size := str_int(SizeStr);
  229.                   if Size < 0 then Size := 0;
  230.                   if Size < FileSize(RXFile) then
  231.                   begin
  232.                     Seek(RXFile,Size);
  233.                     Truncate(RXFile);
  234.                     if Size > 0 then
  235.                     begin
  236.                       VorWrite[Kanal]^[stV] := VorWrite[Kanal]^[stV] + B1 + SizeStr;
  237.                       Chr_Vor_Show(Kanal,_End,#255);
  238.                     end;
  239.                   end;
  240.                   RX_CRC := 0;
  241.                   RX_Count := 0;
  242.                   RX_Laenge := 0;
  243.                   RX_Save := true;
  244.                 end else
  245.                 begin
  246.                   FiResult := CloseBin(RXFile);
  247.                   RX_Bin := 0;
  248.                 end;
  249.               end else
  250.               begin   (* alles klar, File ist nicht da *)
  251.                 if RewriteBin(RXFile,T) = 0 then
  252.                 begin
  253.                   RX_CRC := 0;
  254.                   RX_Count := 0;
  255.                   RX_Laenge := 0;
  256.                   RX_Save := true;
  257.                 end else Fehler := true;
  258.               end;
  259.             end else
  260.  
  261.             if RX_Bin = 3 then     (* Auto-Binär *)
  262.             begin
  263.               if Exists(FRxName) then
  264.               begin    (* File vorhanden !!! *)
  265.                 Assign(RXFile,FRxName);
  266.                 FiResult := ResetBin(RxFile,T);
  267.                 Size := FileSize(RXFile);
  268.                 FiResult := CloseBin(RxFile);
  269.                 l := Size;
  270.                 SizeStr := int_str(l);
  271.                 G^.Fstr[14] := FRxName + B1 + InfoZeile(156);
  272.                 G^.Fstr[15] := InfoZeile(286) + B1+ FormByte(SizeStr) + B3 + InfoZeile(287);
  273.                 if l mod 1000 < 300 then l := l - 1000;
  274.                 if l < 0 then l := 0;
  275.                 SizeStr := int_str((l div 1000) * 1000);
  276.                 Fenster;
  277.                 Alarm;
  278.                 GetString(SizeStr,Attrib[3],10,length(G^.Fstr[15])+3,15,KC,3,Ins);
  279.                 if KC <> _Esc then
  280.                 begin
  281.                   l := str_int(SizeStr);
  282.                   if l < 0 then l := 0;
  283.                   if l < Size then
  284.                   begin
  285.                     RX_Count := l;
  286.                     if l > 0 then
  287.                     begin
  288.                       VorWrite[Kanal]^[stV] := VorWrite[Kanal]^[stV] + B1 + SizeStr;
  289.                       Chr_Vor_Show(Kanal,_End,#255);
  290.                     end;
  291.                   end else RX_Count := Size;
  292.                 end else RX_Bin := 0;
  293.               end else AutoBinOn := true; (* alles klar, File ist nicht da *)
  294.             end else RX_Bin := 0;
  295.           end else Fehler := true;
  296.         end else RX_Bin := 0;
  297.  
  298.         if Fehler then
  299.         begin
  300.           RX_Bin := 0;
  301.           Alarm;
  302.           G^.Fstr[15] := FRxName + B2 + InfoZeile(75) + B2 + InfoZeile(78);
  303.           Fenster;
  304.           SetzeCursor(length(G^.Fstr[15])+2,15);
  305.           Warten;
  306.         end;
  307.         Cursor_aus;
  308.       end else RX_Bin := 0;
  309.     end;
  310.   end else Alarm;
  311. End;
  312.  
  313.  
  314. Function OpenTextFile (* Kanal : Byte) : Boolean *);
  315. Var   Result : Word;
  316. Begin
  317.   with K[Kanal]^ do
  318.   begin
  319.     Assign(RXFile,FRxName);
  320.     Result := ResetBin(RxFile,T);
  321.     if Result = 0 then Seek(RXFile,FileSize(RXFile))
  322.                   else Result := RewriteBin(RxFile,T);
  323.     OpenTextFile := Result = 0;
  324.   end;
  325. End;
  326.  
  327.  
  328. Procedure OpenBinFile (* Kanal : Byte; Zeile : Str80 *);
  329. Var  i    : Byte;
  330.      Free : LongInt;
  331.  
  332.   Function NewName(Kanal,Art : Byte; NStr : Str12) : Str25;
  333.   var   i    : Byte;
  334.         Ext  : String[4];
  335.         Sstr : String[8];
  336.         Hstr : String[12];
  337.         Flag : Boolean;
  338.  
  339.   begin
  340.     Hstr := K[Kanal]^.Call;
  341.     Strip(Hstr);
  342.     i := 0;
  343.  
  344.     if Art = 0 then
  345.     begin
  346.       Repeat
  347.         inc(i);
  348.         Sstr := int_str(i) + Hstr;
  349.         Flag := not Exists(G^.BinPfad + Sstr + BS + Nstr);
  350.       Until Flag or (i > 250);
  351.       if Flag then
  352.       begin
  353.         if MkSub(G^.BinPfad + Sstr) then NewName := Sstr + BS + Nstr;
  354.       end else
  355.       begin
  356.         Ext := Pkt + ParmStr(2,Pkt,Nstr);
  357.         Repeat
  358.           inc(i);
  359.         Until not Exists(G^.BinPfad + Hstr + SFillStr(2,'0',int_str(i)) + Ext);
  360.         NewName := Hstr + SFillStr(2,'0',int_str(i)) + Ext;
  361.       end;
  362.     end;
  363.  
  364.     if Art = 1 then
  365.     begin
  366.       Repeat
  367.         inc(i);
  368.         Ext := Pkt + SFillStr(3,'0',int_str(i));
  369.       Until not Exists(G^.BinPfad + Hstr + Ext);
  370.       NewName := Hstr + Ext;
  371.     end;
  372.   end;
  373.  
  374. Begin
  375.   with K[Kanal]^ do
  376.   begin
  377.     KillEndBlanks(Zeile);
  378.     Zeile := UpCaseStr(Zeile);
  379.  
  380.     { #BIN#818#|32501#$1AC785A4#A:\TREMEX\VIRUS.TXT }
  381.     { #BIN#205453#|55561#$1EB98723?#fpac391.Lzh }
  382.  
  383.     delete(Zeile,1,5);
  384.     i := pos(LZ,Zeile);
  385.     if i = 0 then i := length(Zeile)
  386.              else dec(i);
  387.     if i > 0 then RX_Laenge := LongInt(str_int(copy(Zeile,1,i)))
  388.              else RX_Laenge := 0;
  389.  
  390.     if RX_laenge > 0 then
  391.     begin
  392.       Free := DiskFree(Ord(FRxName[1])-64);
  393.       if (Free + FFFF) > RX_Laenge then
  394.       begin
  395.         if pos(Pipe,Zeile) > 0 then
  396.         begin
  397.           delete(Zeile,1,pos(Pipe,Zeile));
  398.           i := pos(LZ,Zeile);
  399.           if i > 0 then
  400.           begin
  401.             RX_Soll_CRC := Word(str_int(copy(Zeile,1,i-1)));
  402.             delete(Zeile,1,i);
  403.           end else RX_Soll_CRC := 0;
  404.         end else RX_Soll_CRC := 0;
  405.  
  406.         if (pos('$',Zeile) = 1) and (pos(LZ,Zeile) in [10,11]) then
  407.         begin
  408.           RX_Date := str_int(copy(Zeile,1,9));
  409.           delete(Zeile,1,pos(LZ,Zeile));
  410.         end else RX_Date := 0;
  411.  
  412.         if RX_Bin = 0 then
  413.         begin
  414.           While pos(DP,Zeile) > 0 do delete(Zeile,1,pos(DP,Zeile));
  415.           While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
  416.           if SaveNameCheck(0,Zeile) then
  417.           begin
  418.             if pos(Pkt,Zeile) > 0 then
  419.             begin
  420.               if Exists(G^.BinPfad + Zeile) then Zeile := NewName(Kanal,0,Zeile);
  421.             end else Zeile := NewName(Kanal,1,Zeile);
  422.           end else Zeile := NewName(Kanal,1,Zeile);
  423.           FRxName := G^.BinPfad + Zeile;
  424.         end;
  425.  
  426.         Assign(RXFile,FRxName);
  427.  
  428.         if RX_Bin = 0 then
  429.         begin
  430.           RemoteSave := true;
  431.           FiResult := RewriteBin(RXFile,T);
  432.         end;
  433.  
  434.         if RX_Bin = 3 then
  435.         begin
  436.           FiResult := ResetBin(RXFile,T);
  437.           if FiResult = 0 then
  438.           begin
  439.             Seek(RXFile,RX_Count);
  440.             Truncate(RXFile);
  441.           end else FiResult := RewriteBin(RXFile,T);
  442.         end;
  443.  
  444.         if RX_Bin = 4 then
  445.         begin
  446.           RemoteSave := true;
  447.           FiResult := RewriteBin(RXFile,T);
  448.         end;
  449.  
  450.         if FiResult = 0 then
  451.         begin
  452.           if not FileSend then
  453.           begin
  454.             S_PAC(Kanal,NU,true,Meldung[9] + M1);   { #OK# }
  455.             InfoOut(Kanal,0,1,Meldung[9]);
  456.           end;
  457.           RX_Save := true;
  458.           Ignore := true;
  459.           RX_Time := Uhrzeit;
  460.           RX_Count := 0;
  461.           RX_TextZn := 0;
  462.           RX_CRC := 0;
  463.           RX_Bin := 5;
  464.           if Klingel and BLTON then Beep(1400,100);
  465.         end else
  466.         begin
  467.           S_Aus(Kanal,3,M1 + Meldung[10] + M1);  { #ABORT# }
  468.           S_PAC(Kanal,NU,true,'');
  469.         end;
  470.       end else
  471.       begin
  472.         RX_Bin := 0;
  473.         RemoteSave := false;
  474.         Ignore := false;
  475.         S_Aus(Kanal,3,M1 + Meldung[10] + M1);  { #ABORT# }
  476.         S_PAC(Kanal,NU,true,'');
  477.         SetzeFlags(Kanal);
  478.       end;
  479.     end;
  480.   end;
  481. End;
  482.  
  483.  
  484. Procedure CloseRxFile (* Kanal,Art : Byte *);
  485. Var    dt : DateTime;
  486. Begin
  487.   with K[Kanal]^ do
  488.   begin
  489.     if (RX_Bin = 5) and (RX_Date > 0) then
  490.     begin
  491.       if Art = 1 then
  492.       begin
  493.         UnpackTime(RX_Date,dt);
  494.         dt.Year := dt.Year + 50;
  495.         PackTime(dt,RX_Date);
  496.       end;
  497.       SetFTime(RxFile,RX_Date);
  498.     end;
  499.     FiResult := CloseBin(RxFile);
  500.   end;
  501. End;
  502.  
  503.  
  504. Procedure SaveFile (* Kanal : Byte *);
  505. var     Result : Word;
  506.         Hstr   : String[60];
  507.         KC     : Sondertaste;
  508.         Flag   : Boolean;
  509. Begin
  510.   with K[Kanal]^ do
  511.   begin
  512.     if Save then
  513.     begin
  514.       Save := false;
  515.       FiResult := CloseBin(SFile);
  516.     end else
  517.     begin
  518.       Flag := false;
  519.       Fenster;
  520.       GetString(SvName,Attrib[3],60,2,15,KC,1,Ins);
  521.       if KC <> _Esc then
  522.       begin
  523.         SvName := SvFRxCheck(Kanal,SvName,SaveName);
  524.  
  525.         if not PfadOk(1,SvName) then
  526.         begin
  527.           Hstr := SvName;
  528.           While Hstr[length(Hstr)] <> BS do delete(Hstr,length(Hstr),1);
  529.           Flag := MkSub(Hstr) and PfadOk(1,SvName);
  530.         end else Flag := true;
  531.  
  532.         if Flag then
  533.         begin
  534.           Assign(SFile,SvName);
  535.           Result := ResetBin(SFile,T);
  536.           If Result = 0 then Seek(SFile,FileSize(SFile))
  537.                         else if Result = 2 then Result := RewriteBin(SFile,T);
  538.           if Result in [0,2] then Save := true;
  539.         end;
  540.  
  541.         if not Save then
  542.         begin
  543.           Alarm;
  544.           G^.Fstr[15] := InfoZeile(295) + B2 + InfoZeile(78);
  545.           Fenster;
  546.           SetzeCursor(length(G^.Fstr[15])+2,15);
  547.           Warten;
  548.           Cursor_aus;
  549.         end else SvLRet := true;
  550.       end;
  551.     end;
  552.   end;
  553. End;
  554.  
  555.  
  556. Function SvFRxCheck (* Kanal : Byte; Zeile : Str60; Name : Str12) : Str60 *);
  557. Begin
  558.   if (Zeile = '') or (Zeile[length(Zeile)] = BS) or not SaveNameCheck(1,Zeile)
  559.    then Zeile := G^.SavePfad + Name + SFillStr(3,'0',int_str(Kanal));
  560.   if pos(Pkt,Zeile) = 0 then Zeile := Zeile + Pkt + SFillStr(3,'0',int_str(Kanal));
  561.   if pos(DP,Zeile) = 0 then Zeile := G^.SavePfad + Zeile;
  562.   SvFRxCheck := Zeile;
  563. End;
  564.